perm filename DATA.LSP[F87,JMC] blob
sn#850854 filedate 1987-12-28 generic text, type T, neo UTF8
;;; -*- Syntax: Common-lisp; Package: PZ; Default-character-style: (:FIX :BOLD :NORMAL) -*-
(special *original-board*)
(defparameter *default-initial-position*
'(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 :blank))
(defstruct board
(Name (gentemp "BOARD-"))
(position (make-array 16 :initial-contents
*default-initial-position*))
(blank 16) ; Current position of blank.
(blank-origin nil) ; Original position of blank
(completed-chain 0) ; Length of continuous sequence of tiles in
; in correct position, starting with 1.
(last-complete-row 0) ; Last row whose tiles are all in correct place.
(moves nil) ; List of moves that generate this position
; from initial position.
(side 4) ; number of squares on a side. Size of
; POSTION should = side squared.
)
(defstruct FIFO-Queue
(line (list nil)) ; The initial contents of the queue is the node that
; is the original position - a node reached in no moves.
)
(defparameter *base-board*
(make-board :name "Base Board"))
(defparameter *hidden-board*
(make-board :name "Hidden Board"))
(defparameter *adjacency-moves*
(make-array 16 :initial-contents
(loop for ix from 1 to 16
collect
(nconc (when (> (- ix 4) 0)
(list (- ix 4))) ;above
(unless (= (mod ix 4) 1)
(list (- ix 1))) ;left
(unless (= (mod ix 4) 0)
(list (+ ix 1))) ;right
(when (< (+ ix 4) 17)
(list (+ ix 4))))))) ;below
(defparameter *Queue* (make-fifo-queue))
(defparameter *acceptances* 0)
(defparameter *rejections* 0)
(defparameter *nodes-considered* 0)
(defparameter *acceptance-trace* nil)
(defmacro Tform (wl dur &rest args)
`(if *acceptance-trace* (format t ,@args) (sys:%beep ,wl ,dur)))